The software archive

Posted by pulkomandy on Sat Jul 16 20:50:40 2011  •  Comments (0)  • 

This is the script that runs my BeOS software archive

This is a website presenting software, similar to aminet for the amiga or others repositories. It runs without a database and is meant to be easily open to external contributions through ftp uploading.

The full script is less than 200 lines of perl and features a category hierarchy, screenshots, and some other useful infos about the software.

As usual, it is distributed under the MIT Licence.

#!/bin/perl -w
use strict;
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use Time::HiRes qw(tv_interval gettimeofday);

my $t0 = [gettimeofday];

my @QUERY = split(/&/, $ENV{'QUERY_STRING'});
my %query;
foreach my $i (@QUERY)
{
    my $mydata;
    my $varname;
    ($varname, $mydata) = split(/=/, $i);
    $query{$varname} = $mydata ;
}
# POST
my $line;
read(STDIN, $line, $ENV{'CONTENT_LENGTH'});
@QUERY = split(/&/, $line);
foreach my $i (@QUERY)
{
    my $mydata;
    my $varname;
    ($varname, $mydata) = split(/=/, $i);
    $query{$varname} = $mydata ;
}

print "Content-Type: text/html\n\n";
print <<ENDHTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta name="keywords" content="Haiku Software Archive BeOS" />
<meta name="description" content="BeOS software archive" />
<meta http-equiv="content-type" content="text/html; charset=iso-8859-15" />
<title>PulkoMandy's BeOS software archive</title>
<link href="style.css" rel="stylesheet" type="text/css" media="screen" />
</head>
<body>
<h1>PulkoMandy's BeOS software archive</h1>
<div>
<p>This is an archive of BeOS software. Unlike BeBits, the files are archived locally so if their origin gets lost, they'll still here safely.</p>

<p>Most of the files in this archive are from the emupt website, gathered by Xeon3D. Thanks to him for the great work.</p>
<p>You can access the archive directly if you don't like this web interface <a href="archive/">here</a>.</p>
<p>Most of the stuff from emupt is still unsorted, have a look <a href="www.emupt.com">here</a>.</p>

<p>The main goal of this website is to try to get some of this software open sourced so it can be improved for future use.
Tracking of the original authors is sometimes difficult, but usually gives good results. They may also be happy to know the
BeOS world is still alive. This goal is the reason for the separation in three folders.</p>
<ul>
<li>Nosource : unfortunately, these apps are closed source. We need to get in touch with the authors and ask them to release the code.</li>
<li>Source: these application are distributed with their source code, but they are not updated anymore. Take over the development of some of them !</li>
<li>Adopted : these apps are living their own life somewhere else.</li>
</div>
ENDHTML
;

if ($query{file}) { # User wants to show details about a file
    my $file = $query{file};
    open(F, "$file.desc");
    my %data;
    my $description;
    while (<F>) {
        my $field;
        my $value;
        ($field, $value) = split(/:/,$_,2);
        if (length($value) > 0 && $field =~ /^[a-z]+$/) {
            $data{$field} = $value;
        } else {
            $description = $description . $_;
        }
    }
    print "
    <h2><a href=\"$file\">Download $data{name}</a></h2>
    <table>
    <tr><th>Short description</th><td>$data{shortdesc}</td></tr>
    <tr><th>Author</th><td><a href=\"$data{url}\">$data{author}</a></td></tr>
    <tr><th>Platform</th><td>$data{platform}</td></tr>
    <tr><th>Version</th><td>$data{version}</td></tr>
    <tr><th>Licence</th><td>$data{licence}</td></tr>
    <tr><th>Date</th><td>$data{year}</td></tr>
    </table>
    <img src=\"$data{screenshot}\" alt=\"screenshot\"/>";
    print "<p>$description</p>";
    close(F);

    print "<a href=\"/~beosarchive/\">Go up</a>";
} else { #User wants the full software list
    print "<h2>Full software list</h2>";

    sub loopDir {
        my $f;
        my($dir) = @_;
        local(*DIR);
        opendir(DIR, "$dir");
        while ($f=readdir(DIR)) {
            next if ($f eq "." || $f eq "..");

            my $path = "$dir/$f";

            if (-d $path) {
                # We found a directory: recurse into it
                print "<li class=\"dir\">$f</li>\n";
                print("<ul class=\"dir\">");
                &loopDir($path);
            } elsif($path =~ /\.desc$/) {
                # we found a .desc file
                $f = substr($f, 0, -5);
                $path = "$dir/$f";
                print "<li class=\"file\"><a href=\"?file=$path\">$f</a></li>\n";
            }
        }
        closedir(DIR);
        print "</ul>";
    }

    print "<div style=\"float:left\"><h3>Files without source</h3><ul>";
    loopDir("archive/nosource");
    print "</ul></div><div style=\"float:left\"><h3>Files with source looking \
        for a maintainer</h3>";
    loopDir("archive/source");
    print "</ul></div><div style=\"float:left\"><h3>Adopted projects</h3>";
    loopDir("archive/adopted");
    print "</ul></div>";
}

my $elapsed = tv_interval ( $t0 );
print "<p style=\"clear:both; width:100%; border-top: 1px solid #ECC;\">\
    Page generated in $elapsed seconds.</p></body>";

Leave a comment

Name: Mail: